home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyAEProperties.p < prev    next >
Encoding:
Text File  |  1996-05-29  |  6.6 KB  |  218 lines  |  [TEXT/CWIE]
  1.     procedure InitAEUtils;
  2. {  function GetPropertyFromContainer (prop: DescType; container: AEDesc; var result: AEDesc): OSErr;}
  3. {    function SetPropertyFromContainer (prop: DescType; container: AEDesc; value: AEDesc): OSErr;}
  4.     function MyOAFindProperty (desiredClass: DescType; containerToken: AEDesc; containerClass: DescType; keyForm: DescType; keyData: AEDesc; var token: AEDesc; refcon: LongInt): OSErr;
  5.     function SetPropertyFromToken (token: AEDesc; value: AEDesc): OSErr;
  6.     function SetPropertyRecord (token: AEDesc; value: AEDesc): OSErr;
  7.     function GetPropertyFromToken (token: AEDesc; var result: AEDesc): OSErr;
  8.     function GetPropertyRecord (token: AEDesc; var result: AERecord): OSErr;
  9.  
  10.     function StorePropertyReferenceInToken (prop: DescType; container: AEDesc; var token: AEDesc): OSErr;
  11.     function RetrievePropertyReferenceFromToken (token: AEDesc; var prop: DescType; var container: AEDesc): OSErr;
  12.     function ValidProperty (class, prop: DescType): boolean;
  13.     function GetIndProperty (class: DescType; index: integer; var prop: DescType): boolean;
  14.  
  15. var
  16.         GetPropertyFromContainerProc: ProcPtr;
  17.         SetPropertyFromContainerProc: ProcPtr;
  18.  
  19. {$S Init}
  20.     procedure InitAEUtils (GetPropertyFromContainer, SetPropertyFromContainer: ProcPtr);
  21.     begin
  22.         GetPropertyFromContainerProc := GetPropertyFromContainer;
  23.         SetPropertyFromContainerProc := SetPropertyFromContainer;
  24.     end;
  25. {$S}
  26.  
  27.     function CallGetPropertyFromContainer (prop: DescType; container: AEDesc; var result: AEDesc; p: Ptr): OSErr;
  28.     inline
  29.         $205F, $4E90;
  30.  
  31.     function CallSetPropertyFromContainer (prop: DescType; container: AEDesc; value: AEDesc; p: Ptr): OSErr;
  32.     inline
  33.         $205F, $4E90;
  34.  
  35.     function StorePropertyReferenceInToken (prop: DescType; container: AEDesc; var token: AEDesc): OSErr;
  36.         var
  37.             h: Handle;
  38.             err: OSErr;
  39.     begin
  40.         h := nil;
  41.         err := PtrToHand(@prop, h, SizeOf(DescType));
  42.         if err = noErr then
  43.             err := PtrAndHand(@container.descriptorType, h, SizeOf(DescType));
  44.         if err = noErr then
  45.             err := HandAndHand(container.dataHandle, h);
  46.         if err = noErr then begin
  47.             HLock(h);
  48.             err := AECreateDesc(typeMyPropertyToken, h^, GetHandleSize(h), token);
  49.         end;
  50.         DisposeHandle(h);
  51.         StorePropertyReferenceInToken := err;
  52.     end;
  53.  
  54.     function RetrievePropertyReferenceFromToken (token: AEDesc; var prop: DescType; var container: AEDesc): OSErr;
  55.         var
  56.             conttype: DescType;
  57.             err: OSErr;
  58.     begin
  59.         BlockMove(token.dataHandle^, @prop, SizeOf(DescType));
  60.         BlockMove(Ptr(ord(token.dataHandle^) + SizeOf(DescType)), @conttype, SizeOf(DescType));
  61.         HLock(token.dataHandle);
  62.         err := AECreateDesc(conttype, Ptr(ord(token.dataHandle^) + 2 * SizeOf(DescType)), GetHandleSize(token.dataHandle) - 2 * SizeOf(DescType), container);
  63.         HUnlock(token.dataHandle);
  64.         if err <> noErr then begin
  65.             AECreate(container);
  66.         end;
  67.         RetrievePropertyReferenceFromToken := err;
  68.     end;
  69.  
  70.     type
  71.         propertiesRecord = record
  72.                 count: integer;
  73.                 props: array[1..1000] of DescType;
  74.             end;
  75.         propertiesRecordPtr = ^propertiesRecord;
  76.         propertiesRecordHandle = ^propertiesRecordPtr;
  77.  
  78.     function OSTypeToString (ost: OSType): Str15;
  79.         var
  80.             s: Str15;
  81.     begin
  82.         s[0] := chr(4);
  83.         BlockMove(@ost, @s[1], 4);
  84.         OSTypeToString := s;
  85.     end;
  86.  
  87.     function GetIndProperty (class: DescType; index: integer; var prop: DescType): boolean;
  88.         var
  89.             h: propertiesRecordHandle;
  90.     begin
  91.         h := propertiesRecordHandle(GetNamedResource(myPropertiesResType, OSTypeToString(class)));
  92.         GetIndProperty := false;
  93.         if h <> nil then begin
  94.             if (0 < index) & (index <= h^^.count) then begin
  95.                 prop := h^^.props[index];
  96.                 GetIndProperty := true;
  97.             end;
  98.             HPurge(Handle(h));
  99.         end;
  100.     end;
  101.  
  102.     function ValidProperty (class, prop: DescType): boolean;
  103.         var
  104.             h: propertiesRecordHandle;
  105.             i: integer;
  106.     begin
  107.         h := propertiesRecordHandle(GetNamedResource(myPropertiesResType, OSTypeToString(class)));
  108.         ValidProperty := false;
  109.         if h <> nil then begin
  110.             for i := 1 to h^^.count do begin
  111.                 if h^^.props[i] = prop then begin
  112.                     ValidProperty := true;
  113.                     leave;
  114.                 end;
  115.             end;
  116.             HPurge(Handle(h));
  117.         end;
  118.     end;
  119.  
  120.     function MyOAFindProperty (desiredClass: DescType; containerToken: AEDesc; containerClass: DescType; keyForm: DescType; keyData: AEDesc; var token: AEDesc; refcon: LongInt): OSErr;
  121.         var
  122.             err: OSErr;
  123.             prop: DescType;
  124.     begin
  125.         if keyForm = formPropertyID then begin
  126.             err := GetTypeFromAEDesc(keyData, prop);
  127.             if err = noErr then begin
  128.                 if ValidProperty(containerToken.descriptorType, prop) then begin
  129.                     err := StorePropertyReferenceInToken(prop, containerToken, token);
  130.                 end
  131.                 else begin
  132.                     err := errAENoSuchObject;
  133.                 end;
  134.             end;
  135.         end
  136.         else begin
  137.             err := errAEBadKeyForm;
  138.         end;
  139.         MyOAFindProperty := err;
  140.     end;
  141.  
  142.     function SetPropertyFromToken (token: AEDesc; value: AEDesc): OSErr;
  143.         var
  144.             err, junk: OSErr;
  145.             prop: DescType;
  146.             container: AEDesc;
  147.     begin
  148.         err := RetrievePropertyReferenceFromToken(token, prop, container);
  149.         if err = noErr then begin
  150.             err := CallSetPropertyFromContainer(prop, container, value, SetPropertyFromContainerProc);
  151.         end;
  152.         AEDestroy(container);
  153.         SetPropertyFromToken := err;
  154.     end;
  155.  
  156.     function SetPropertyRecord (token: AEDesc; value: AEDesc): OSErr;
  157.         var
  158.             index: integer;
  159.             prop: DescType;
  160.             element: AEDesc;
  161.             err, junk: OSErr;
  162.     begin
  163.         index := 1;
  164.         while (err = noErr) & GetIndProperty(token.descriptorType, index, prop) do begin
  165.             err := AEGetKeyDesc(value, prop, typeWildCard, element);
  166.             if err = noErr then begin
  167.                 err := CallSetPropertyFromContainer(prop, token, element, SetPropertyFromContainerProc);
  168.                 AEDestroy(element);
  169.             end
  170.             else if err = errAEDescNotFound then begin
  171.                 err := noErr;
  172.             end;
  173.             index := index + 1;
  174.         end;
  175.         SetPropertyRecord := err;
  176.     end;
  177.  
  178.     function GetPropertyFromToken (token: AEDesc; var result: AEDesc): OSErr;
  179.         var
  180.             err, junk: OSErr;
  181.             prop: DescType;
  182.             container: AEDesc;
  183.     begin
  184.         err := RetrievePropertyReferenceFromToken(token, prop, container);
  185.         if err = noErr then begin
  186.             err := CallGetPropertyFromContainer(prop, container, result, GetPropertyFromContainerProc);
  187.         end;
  188.         AEDestroy(container);
  189.         GetPropertyFromToken := err;
  190.     end;
  191.  
  192.     function GetPropertyRecord (token: AEDesc; var result: AERecord): OSErr;
  193.         var
  194.             index: integer;
  195.             prop: DescType;
  196.             element: AEDesc;
  197.             err, junk: OSErr;
  198.     begin
  199.         err := AECreateList(nil, 0, true, result);
  200.         index := 1;
  201.         while (err = noErr) & GetIndProperty(token.descriptorType, index, prop) do begin
  202.             err := CallGetPropertyFromContainer(prop, token, element, GetPropertyFromContainerProc);
  203.             if err = noErr then begin
  204.                 err := AEPutKeyDesc(result, prop, element);
  205.                 AEDestroy(element);
  206.             end
  207.             else if err = errAEReadDenied then begin
  208.                 err := noErr;
  209.             end;
  210.             index := index + 1;
  211.         end;
  212.         if err <> noErr then begin
  213.             AEDestroy(result);
  214.         end;
  215.         GetPropertyRecord := err;
  216.     end;
  217.  
  218.